home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / ai / neural22 / dosdemo2.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-04  |  7KB  |  261 lines
  1.  
  2. {$ifdef windows}
  3. uses objects,dyna2,nnunit2,wincrt,cfmtools, bpnet2;
  4. {$else}
  5. uses objects,dyna2,nnunit2,crt,cfmtools, bpnet2;
  6. {$endif}
  7.  
  8. {$F+}
  9. label stop;
  10.  
  11. const
  12.      incount         = 2;
  13.      hidecount       = 2;
  14.      outcount        = 1;
  15.  
  16. var
  17.    max          : longint;
  18.    net          : psimpleBPnet;
  19.    i,j,k        : longint;
  20.    desiredmat   : pdynamat;
  21.    inputmat     : pdynamat;
  22.    errorvec     : pdynavec;
  23.    invec        : pdynavec;
  24.    desiredvec   : pdynavec;
  25.    linelength   : integer;
  26.    lines        : integer;
  27.    totalerror   : double;
  28.    lasterror    : double;
  29.    num          : double;
  30.    thisone      : pneuron;
  31.    data     : text;
  32.    log      : text;
  33.    stuff    : string;
  34.    learn    : double;
  35.    count    : integer;
  36.    momentum : double;
  37.    kmod     : double;
  38.    maxcount : integer;
  39.    maxerr   : double;
  40.    key      : char;
  41.    io       : pdosstream;
  42.  
  43. {-----------------------------}
  44. procedure printmattofile(var filevar: text; var mat: dynamat);
  45. {-----------------------------}
  46. var
  47.    i,j          : integer;
  48.  
  49. begin
  50.      for i := 1 to mat.nrow do
  51.       begin
  52.       for j := 1 to mat.ncol do write(filevar,mat.get(i,j):8:4 );
  53.       writeln(filevar);
  54.       end;
  55.      writeln(filevar);
  56. end;
  57.  
  58.  
  59. {              ------------- Main -----------------}
  60.  
  61.  
  62. begin
  63.                                 {Initialize stuff...}
  64.      randomize;
  65.      clrscr;
  66.      max := memavail;
  67.      net := nil;
  68.  
  69.      if opentextfile('xor.dat',data) <> 0 then
  70.          begin
  71.          writeln('Could not open XOR.DAT');
  72.          halt(1);
  73.          END;
  74.      if createtextfile('bp2.log',log) <> 0 then halt(1);
  75.  
  76.                                    {count lines}
  77.  
  78.      readln(data,stuff);
  79.      writeln(log,stuff);
  80.      readln(data,lines,learn,momentum,kmod,maxerr,maxcount);
  81.      spacedline(log,' ');
  82.      writeln(log,lines:8,' lines  of IO data. ',#13#10,
  83.                  'Lcoeff= ',learn:8:2,
  84.                  ' Momentum= ',momentum:8:2,
  85.                  ' Kmod    = ',kmod:6:2,
  86.                  ' Maxerr= ',maxerr:8:6,
  87.                  ' Maxcount= ', maxcount:5);
  88.      spacedline(log,' ');
  89.      writeln(lines:8,' lines  of IO data. ',#13#10,
  90.                  'Lcoeff= ',learn:8:2,
  91.                  ' Momentum= ',momentum:8:2,
  92.                  ' Kmod    = ',kmod:6:2,#13,#10,
  93.                  ' Maxerr= ',maxerr:8:6,
  94.                  ' Maxcount= ', maxcount:5);
  95.  
  96.      writeln('Examining data...');
  97.      lines := countlines(data);
  98.      readln(data);readln(data);
  99.      linelength:= incount+outcount;
  100.  
  101.      writeln('Initializing structures...');
  102.      new(desiredmat,init(lines,outcount));
  103.      new(errorvec,init(outcount,1));
  104.      new(inputmat,init(lines,linelength));
  105.  
  106.  
  107.                                 {Make Backpropnet}
  108.  
  109.      new(net,init(incount,hidecount,outcount,learn,momentum));
  110.      if neuralerror <> 0 then
  111.        begin
  112.        printneuralerror;
  113.        if net <> nil then dispose(net,done);
  114.        halt(1);
  115.        end;
  116.  
  117.      net^.shake(0.5);
  118.      net^.setfieldsignal(net^.hiddenfield,sigmoid);
  119.      net^.setfieldsignal(net^.outputfield,linear);
  120. {     net^.disconnectbetween(net^.offset,net^.outputfield);}
  121.  
  122.  
  123.      printmattofile(log,net^.weights^);
  124.      printdynaerror;
  125.      printneuralerror;
  126.  
  127.                               {Get input data}
  128.  
  129.      linestomat(data,inputmat^);
  130.      writeln(log,'IO MATRIX');
  131.      printmattofile(log,inputmat^);
  132.  
  133.      for i := 1 to lines do
  134.          for j := 1 to outcount do
  135.             desiredmat^.put(i,j,inputmat^.get(i,incount+j));
  136.      writeln(log,'DESIRED MATRIX');
  137.      printmattofile(log,desiredmat^);
  138.  
  139.      for i := 1 to outcount do inputmat^.deletecol(incount+i);
  140.      writeln(log,'INPUT MATRIX');
  141.      printmattofile(log,inputmat^);
  142.  
  143.  
  144.  
  145.                     {---------- present data -------------}
  146.  
  147.      count      := 0;
  148.  
  149.      repeat
  150.        totalerror := 0;
  151.  
  152.        for j := 1 to lines do
  153.           begin
  154.           inc(count);
  155.           desiredmat^.getrow(j,desiredvec);
  156.           inputmat^.getrow(j,invec);
  157.           net^.feedforward(invec);
  158.  
  159.                                 {make error vector}
  160.  
  161.           for i := 1 to net^.outputfield^.count do
  162.               begin
  163.               thisone := net^.outputfield^.at(i-1);
  164.               lasterror := (desiredvec^.get(i) - thisone^.output);
  165.               totalerror := totalerror + abs(lasterror);
  166.               errorvec^.put(i, lasterror);
  167.               end;
  168.                                 { feed error back}
  169.  
  170.           net^.train(errorvec);
  171.           end;
  172.  
  173.        if ((count mod (5*lines)) = 0) then
  174.                  writeln(log,'Event # ',count,
  175.                             totalerror:12:6);
  176.  
  177.  
  178.        gotoxy(1,9);
  179.        write(count:10,totalerror:20:14,net^.learn:20:10,#13);
  180.        for i:= 1 to errorvec^.count do
  181.                     errorvec^.put(i,0.0);
  182.        lasterror  := totalerror;
  183.        totalerror := 0;
  184.  
  185.  
  186.  
  187.        if keypressed then
  188.          begin
  189.          key := readkey;
  190.  
  191.          if key = 'w' then
  192.             begin
  193.             new(io,init('net.stm',stcreate));
  194.             io^.put(net);
  195.             dispose(io,done);
  196.             end;
  197.  
  198.          if key = 'r' then
  199.             begin
  200.             dispose(net,done);
  201.             new(io,init('net.stm',stopen));
  202.             net := psimplebpnet(io^.get);
  203.             dispose(io,done);
  204.             end;
  205.  
  206.          if key='s' then net^.shake(1.0);
  207.          if key='S' then net^.shake(3.0);
  208.          if key='l' then net^.learn := 0.7*net^.learn;
  209.          if key='L' then net^.learn := 1.3*net^.learn;
  210.          if (key='q') or (key = 'Q') then
  211.            begin
  212.            writeln('         Stopped...');
  213.            goto stop;
  214.            end;
  215.          end;
  216.  
  217.        until (lasterror <maxerr) or (count > maxcount);
  218.  
  219.  
  220.  
  221.  
  222. stop:
  223.      spacedline(log,'Final Weights');
  224.      printmattofile(log,net^.weights^);
  225.  
  226.      spacedline(log,'Network response: ');
  227.      writeln;
  228.      writeln('Updating logfile...');
  229.      for j := 1 to lines do
  230.           begin
  231.           inputmat^.getrow(j,invec);
  232.           net^.feedforward(invec);
  233.           writeln(log);
  234.           write(log,' inputvec  :');
  235.           printvectofile(log,80,invec^);
  236.           write(log,' response : ');
  237.           for i := 1 to net^.outputfield^.count do
  238.              write(log,pneuron(net^.outputfield^.at(i-1))^.output:8:3);
  239.           end;
  240.      writeln;
  241.  
  242.  
  243.      close(data);
  244.      close(log);
  245.  
  246.      writeln(memavail,' after initialized');
  247.      writeln;
  248.      writeln(max - memavail,' USED');
  249.  
  250.      writeln('Cleaning up...');
  251.      dispose(net,done);
  252.      dispose(errorvec,done);
  253.      dispose(desiredmat,done);
  254.      dispose(inputmat,done);
  255.  
  256.      writeln;
  257.      writeln(memavail,' after cleanup ', (1.0*max-memavail):8:0,' lost');
  258.      writeln('Press return...');
  259.      readln;
  260.      Writeln('Done.');
  261. end.